home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / mac / LOGIC Apple II 5.25" Library - ProDOS / PRO002.dsk / SKETCH.bas < prev    next >
BASIC Source File  |  2012-02-16  |  4KB  |  161 lines
  1. 10  PRINT  CHR$(27);: PRINT  CHR$(17): REM 40 COL.
  2. 20  TEXT : HOME 
  3. 30 V = 1: GOSUB 40:V = 24: GOSUB 40: GOTO 60
  4. 40  VTAB (V): HTAB (1): FOR X = 1 TO 39: PRINT "_";: NEXT 
  5. 50  RETURN 
  6. 60  VTAB (5): HTAB (7)
  7. 70  PRINT "[ THIS PROGRAM IS FREEWARE ]"
  8. 80  PRINT : PRINT : HTAB (4)
  9. 90  PRINT "YOU ARE FREE TO DISTRIBUTE COPIES"
  10. 100  PRINT : HTAB (8)
  11. 110  PRINT "BUT YOU MAY NOT SELL THEM."
  12. 120  VTAB (16): HTAB (11)
  13. 130  PRINT "THE FREEWARE PROJECT"
  14. 140  PRINT : HTAB (11)
  15. 150  PRINT "WALDEN SOFTWARE, INC."
  16. 160  PRINT : HTAB (12)
  17. 170  PRINT "(C) 1984, P. LUTUS"
  18. 180  FOR PAUSE = 0 TO 2500: NEXT 
  19. 190  REM 
  20. 200  REM  SET THINGS UP
  21. 210  REM 
  22. 220 D$ =  CHR$(4)
  23. 230 ID = ( INT( PEEK(49048)/64))
  24. 240  HOME 
  25. 250  HGR 
  26. 260 C = 3
  27. 270 S = 10
  28. 280 XP = 1:YP = 0
  29. 290  ONERR  GOTO 290
  30. 300  GOSUB 1090
  31. 310 OX = XP:OY = YP
  32. 320  GOSUB 1220
  33. 330  REM 
  34. 340  REM PUT DOT ON SCREEN
  35. 350  REM 
  36. 360  HCOLOR= 0
  37. 370  HPLOT 0,YP
  38. 380 A =  PEEK(38) + PEEK(39) *256
  39. 390 A = A +(XP/7)
  40. 400 PT =  PEEK(A)
  41. 410  HCOLOR= 3
  42. 420  HPLOT XP,YP
  43. 430  REM 
  44. 440  REM WAIT FOR KEYPRESS
  45. 450  REM 
  46. 460 K =  PEEK(49152): IF K <127  THEN 460
  47. 470  POKE 49168,0
  48. 480 C$ =  CHR$(K -128)
  49. 490  REM 
  50. 500  REM USE ARROWS IF AVAIL.
  51. 510  REM 
  52. 520  IF  ASC(C$) = 8  THEN C$ = "J"
  53. 530  IF  ASC(C$) = 21  THEN C$ = "K"
  54. 540  IF  ASC(C$) = 10  THEN C$ = "M"
  55. 550  IF  ASC(C$) = 11  THEN C$ = "I"
  56. 560  REM 
  57. 570  REM REMOVE DOT
  58. 580  REM 
  59. 590  POKE A,(PT)
  60. 600  REM 
  61. 610  REM CARRY OUT COMMAND
  62. 620  REM 
  63. 630  GOSUB 640: GOTO 360
  64. 640  IF C$ = "I"  THEN YP = YP -S: GOTO 1090
  65. 650  IF C$ = "M"  THEN YP = YP +S: GOTO 1090
  66. 660  IF C$ = "J"  THEN XP = XP -S: GOTO 1090
  67. 670  IF C$ = "K"  THEN XP = XP +S: GOTO 1090
  68. 680  IF C$ = "D"  THEN  HCOLOR= C: GOTO 1170
  69. 690  IF C$ = "U"  THEN  HCOLOR= 0: GOTO 1170
  70. 700  IF C$ = "S"  THEN OX = XP:OY = YP: HCOLOR= C: GOTO 1170
  71. 710  IF C$ = "-"  THEN 780: REM  STEP
  72. 720  IF C$ = "C"  THEN 820: REM  COLOR
  73. 730  IF C$ = "F"  THEN 860: REM  FILE
  74. 740  IF C$ = "Q"  THEN 990: REM  QUIT
  75. 750  IF C$ = "E"  THEN 1030: REM  ERASE
  76. 760  IF C$ = "A"  THEN 1350: REM  ARC 
  77. 770  RETURN 
  78. 780 Q$ = "ENTER STEP SIZE (1-20):": GOSUB 1310
  79. 790 S =  VAL(L$)
  80. 800  IF S <1  OR S >20  THEN 780
  81. 810  RETURN 
  82. 820 Q$ = "ENTER COLOR (1-7):": GOSUB 1310
  83. 830 C =  VAL(L$)
  84. 840  IF C <0  OR C >7  THEN 820
  85. 850  RETURN 
  86. 860 Q$ = "(L)OAD OR (S)AVE IMAGE :": GOSUB 1310
  87. 870 C$ =  LEFT$(L$,1)
  88. 880  IF C$ = "S"  THEN 910
  89. 890  IF C$ = "L"  THEN 950
  90. 900  RETURN 
  91. 910 Q$ = "ENTER SAVE FILE NAME:": GOSUB 1310
  92. 920  IF L$ = ""  THEN  RETURN 
  93. 930  PRINT D$;"BSAVE";L$;",A$2000,L$2000"
  94. 940  RETURN 
  95. 950 Q$ = "ENTER LOAD FILE NAME:": GOSUB 1310
  96. 960  IF L$ = ""  THEN  RETURN 
  97. 970  PRINT D$;"BLOAD";L$;",A$2000,L$2000"
  98. 980  RETURN 
  99. 990 Q$ = "QUIT (YES/NO):": GOSUB 1310
  100. 1000  IF  LEFT$(L$,1) < >"Y"  THEN  RETURN 
  101. 1010  TEXT : HOME : PRINT  CHR$(4);"-STARTUP"
  102. 1020  IF C$ < >"E"  THEN  RETURN 
  103. 1030 Q$ = "ERASE SCREEN (YES/NO):": GOSUB 1310
  104. 1040  IF  LEFT$(L$,1) < >"Y"  THEN  RETURN 
  105. 1050  HGR : HCOLOR= C: RETURN 
  106. 1060  REM 
  107. 1070  REM CHECK: ON SCREEN?
  108. 1080  REM 
  109. 1090  IF XP <1  THEN XP = 1
  110. 1100  IF XP >279  THEN XP = 279
  111. 1110  IF YP <0  THEN YP = 0
  112. 1120  IF YP >159  THEN YP = 159
  113. 1130  RETURN 
  114. 1140  REM 
  115. 1150  REM  DRAW/UNDRAW LINE
  116. 1160  REM 
  117. 1170  HPLOT OX,OY TO XP,YP:OX = XP:OY = YP
  118. 1180  RETURN 
  119. 1190  REM 
  120. 1200  REM PRINT MENU
  121. 1210  REM 
  122. 1220  HOME 
  123. 1230  VTAB (21)
  124. 1240  PRINT "[ FREEWARE SKETCH PAD (P. LUTUS) ]"
  125. 1250  IF ID = 2  THEN  PRINT "MOVE WITH <CTRL-A>ARROW KEYS,(-)STEP"
  126. 1260  IF ID < >2  THEN  PRINT "(I)UP,(J)LEFT,(K)RIGHT,(M)DOWN,(-)STEP"
  127. 1270  PRINT "(S)TART,(D)RAW,(U)NDRAW,(C)OLOR,(A)RC"
  128. 1280  PRINT "(E)RASE,(F)ILE TO DISK,(Q)UIT";
  129. 1290  VTAB (1)
  130. 1300  RETURN 
  131. 1310  HOME : VTAB (21)
  132. 1320  PRINT Q$;
  133. 1330  INPUT "";L$
  134. 1340  GOTO 1220
  135. 1350  GOSUB 1390: GOTO 1220
  136. 1360  REM 
  137. 1370  REM DRAW ARCS
  138. 1380  REM 
  139. 1390  HOME : VTAB (21)
  140. 1400 F = 57.29577951
  141. 1410 ST = 1
  142. 1420  INPUT "ENTER ARC RADIUS:";L$
  143. 1430  IF L$ = ""  THEN  RETURN 
  144. 1440 AR =  VAL(L$)
  145. 1450  INPUT "ENTER ARC START ANGLE (0 = UP):";L$
  146. 1460  IF L$ = ""  THEN  RETURN 
  147. 1470 SA =  VAL(L$)
  148. 1480  INPUT "ENTER ARC LENGTH (360=FULL):";L$
  149. 1490  IF L$ = ""  THEN  RETURN 
  150. 1500 SL =  VAL(L$)
  151. 1510  INPUT "(D)RAW OR (U)NDRAW:";L$
  152. 1520  HCOLOR= C: IF L$ = "U"  THEN  HCOLOR= 0
  153. 1530 OX = XP:OY = YP
  154. 1540  FOR X = SA TO (SA +SL)  STEP 5
  155. 1550 XP = ( SIN(X/F) *AR) +OX
  156. 1560 YP =  -( COS(X/F) *AR) +OY
  157. 1570  IF ST  THEN QX = XP:QY = YP:ST = 0
  158. 1580  HPLOT QX,QY TO XP,YP
  159. 1590 QX = XP:QY = YP: NEXT X
  160. 1600 XP = OX:YP = OY
  161. 1610  RETURN